Tarea 5. Splines cúbicos.

Análisis Numérico. Luis Antonio Domínguez Ávila

Marzo del 2023

Ejercicio 1.

En cada inciso considera la función de valores reales, usa splines cúbicos para encontrar una aproximación en el intervalo dado. Calcula el valor de la función, de la derivada y en cada caso calcula el error real.

graf<-function(f,x0,x1,x2,x3,x4=NULL,x5=NULL,fder=NULL){
  x_nodes<<-c(x0,x1,x2,x3,x4,x5)
  f_nodes<<-f(x_nodes)
  
  if(!is.null(x5)){
    xMax=x5
  }
  else if(!is.null(x4)){
    xMax=x4
  }
  else{
    xMax=x3
  }
  if(!is.null(fder)){
    x <- x0
    d1=eval(fder)
    x <- xMax
    d2=eval(fder)
    my_spline<<-cubicspline(x_nodes,f_nodes,endp2nd = TRUE,der=c(d1,d2))
    
    x_n<-seq(x0,xMax,length.out=100)
    y_n<-cubicspline(x_nodes,f_nodes,x_n,endp2nd = TRUE,der=c(d1,d2))
  }
  else{
     my_spline<<-cubicspline(x_nodes,f_nodes)
    
    x_n<-seq(x0,xMax,length.out=100)
    y_n<-cubicspline(x_nodes,f_nodes,x_n)
  }
  
  
  graph_spline<-ggplot()+
    geom_function(fun=f,linewidth=1.3,color="dodgerblue")+
    geom_point(aes(x_nodes,f_nodes),color="gold3")+
    geom_line(aes(x_n,y_n),color="red",linewidth=0.75)+
    xlim(x0,xMax)+
    theme_bw()
  
  ggplotly(graph_spline)
}
  1. \(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\). Aproximar \(f(0.43)\) y \(f'(0.43)\).
f <- function(x){exp(2*x)}
f_expr <- expression(exp(2*x))
graf(f,0,.25,.5,.75)
a=0.43
f(a)
## [1] 2.363161
cubicspline(x_nodes,f_nodes,a)
## [1] 2.347353
abs(f(a)-cubicspline(x_nodes,f_nodes,a))
## [1] 0.01580817
# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)
## [1] 17.472473  6.332867  3.122624
polyval(polyder(coefs_2),a)
## [1] 9.076417
fder<-D(f_expr,"x")
x <- a
eval(fder)
## [1] 4.726321
  1. \(f(x)=x\, log(x)\), \(x\in [2,12]\), \(h=2\). Aproximar \(f(8.4)\) y \(f'(8.4)\).
f <- function(x){x*log(x)}
f_expr <- expression(x*log(x))
graf(f,2,4,6,8,10,12)
a=8.4
f(a)
## [1] 17.87715
cubicspline(x_nodes,f_nodes,a)
## [1] 17.87406
abs(f(a)-cubicspline(x_nodes,f_nodes,a))
## [1] 0.003082143
# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)
## [1] -0.05638427  0.35905631  2.31881241
polyval(polyder(coefs_2),a)
## [1] 1.356411
fder<-D(f_expr,"x")
x <- a
eval(fder)
## [1] 3.128232
  1. \(f(x)=sen(e^x-2)\), \(x\in [0,5]\), \(h=1\). Aproximar \(f(0.9)\) y \(f'(0.9)\).
f <- function(x){sin(exp(x)-2)}
f_expr <- expression(sin(exp(x)-2))
graf(f,0,1,2,3,4,5)
a=0.9
f(a)
## [1] 0.4435924
cubicspline(x_nodes,f_nodes,a)
## [1] 0.656121
abs(f(a)-cubicspline(x_nodes,f_nodes,a))
## [1] 0.2125286
# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)
## [1]  4.1692143 -5.1924685 -0.2312599
polyval(polyder(coefs_2),a)
## [1] -1.527418
fder<-D(f_expr,"x")
x <- a
eval(fder)
## [1] 2.204367
  1. \(f(x)=x\, cos\,x-2x^2+3x-1\). \(x\in [0,2]\), \(h=0.5\). Aproximar \(f(0.25)\) y \(f'(0.25)\).
f <- function(x){x*cos(x)-2*x^3+3*x-1}
f_expr <- expression(x*cos(x)-2*x^3+3*x-1)
graf(f,0,.5,1,1.5,2)
a=0.25
f(a)
## [1] -0.03902189
cubicspline(x_nodes,f_nodes,a)
## [1] -0.03225228
abs(f(a)-cubicspline(x_nodes,f_nodes,a))
## [1] 0.006769611
# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)
## [1] -4.622062 -7.894533  2.061827
polyval(polyder(coefs_2),a)
## [1] -0.200685
fder<-D(f_expr,"x")
x <- a
eval(fder)
## [1] 3.532061
  1. \(f(x)=x\,cos\,x-3x\). Puntos: \(x_0=0.1, x_1=0.2, x_2=0.3, x_3=0.4\). Aproximar \(f(0.18)\) y \(f'(0.18)\).
f <- function(x){x*cos(x)-3*x}
f_expr <- expression(x*cos(x)-3*x)
graf(f,0.1,.2,.3,.4)
a=0.18
f(a)
## [1] -0.3629081
cubicspline(x_nodes,f_nodes,a)
## [1] -0.3630025
abs(f(a)-cubicspline(x_nodes,f_nodes,a))
## [1] 9.434063e-05
# Extraer los coeficientes del segundo polinomio
coefs_2<-my_spline$coefs[2,]
#Coeficientes de la derivada del polinomio anterior
polyder(coefs_2)
## [1] -2.8389124 -0.5974756 -2.0547869
polyval(polyder(coefs_2),a)
## [1] -2.254313
fder<-D(f_expr,"x")
x <- a
eval(fder)
## [1] -2.048382

Ejercicio 2

Encuentra los splines cúbicos condicionados para las funciones del ejercicio anterior.

  1. \(f(x)=e^{2x}\). Puntos: \(x_0=0, x_1=0.25, x_2=0.5, x_3=0.75\).
# Definir los puntos y la función
f <- function(x){exp(2*x)}
f_expr <- expression(exp(2*x))
fder<-D(f_expr,"x")
graf(f,0,.25,.5,.75,fder=fder)
  1. \(f(x)=x\, log(x)\), \(x\in [2,12]\), \(h=2\).
# Definir los puntos y la función
f <- function(x){x*log(x)}
f_expr <- expression(x*log(x))
fder<-D(f_expr,"x")
graf(f,2,4,6,8,10,12,fder=fder)
  1. \(f(x)=sen(e^x-2)\), \(x\in [0,5]\), \(h=1\).
# Definir los puntos y la función
f <- function(x){sin(exp(x)-2)}
f_expr <- expression(sin(exp(x)-2))
fder<-D(f_expr,"x")
graf(f,0,1,2,3,4,5,fder=fder)
  1. \(f(x)=x\, cos\,x-2x^2+3x-1\). \(x\in [0,2]\), \(h=0.5\).
# Definir los puntos y la función
f <- function(x){x*cos(x)-2*x^2+3*x-1}
f_expr <- expression(x*cos(x)-2*x^2+3*x-1)
fder<-D(f_expr,"x")
graf(f,0,.5,1,1.5,2,fder=fder)
  1. \(f(x)=x\,cos\,x-3x\). Puntos: \(x_0=0.1, x_1=0.2, x_2=0.3, x_3=0.4\).
# Definir los puntos y la función
f <- function(x){x*cos(x)-3*x}
f_expr <- expression(x*cos(x)-3*x)
fder<-D(f_expr,"x")
graf(f,0.1,.2,.3,.4,fder=fder)

Ejercicio 3

Se sospecha que las elevadas concentraciones de tanina en las hojas de los robles maduros inhiben el crecimiento de las larvas de la polilla invernal (Operophtera bromata L. Geometridae) que tanto dañan a los árboles en algunos años. La tabla anexa contiene el peso promedio de dos muestras de larva, tomadas en los primeros 28 días después de nacimiento. La primera muestra se crió en hojas de robles jóvenes, mientras que la segunda lo hizo en hojas maduras del mismo árbol.

  1. Usa splines cúbicos para aproximar la curva del peso promedio de las muestras.

  2. Para calcular un peso promedio máximo aproximado de cada muestra, determina el máximo del polinomio interpolante.

\[\begin{equation} \begin{array}{l|c|c|c|c|c|c|r} \text{Día} & 0 & 6 & 10 & 13 & 17 & 20 & 28 \\ \hline \text{Peso promedio muestra 1 (mg)} & 6.67 & 17.33 & 42.67 & 37.33 & 30.10 & 29.31 & 28.74 \\ \text{Peso promedio muestra 2 (mg)} & 6.67 & 16.11 & 18.89 & 15.00 & 10.56 & 9.44 & 8.89 \end{array} \end{equation}\]

# Datos de muestra
dias <- c(0, 6, 10, 13, 17, 20, 28)
peso_muestra1 <- c(6.67, 17.33, 42.67, 37.33, 30.10, 29.31, 28.74)
peso_muestra2 <- c(6.67, 16.11, 18.89, 15.00, 10.56, 9.44, 8.89)

# Ajustar splines cúbicos
spline_muestra1 <- spline(dias, peso_muestra1)
spline_muestra2 <- spline(dias, peso_muestra2)

# Encontrar el máximo del polinomio interpolante
maximo_muestra1 <- optimize(splinefun(dias,peso_muestra1), interval = c(0,28), maximum = TRUE)
maximo_muestra2 <- optimize(splinefun(dias,peso_muestra2), interval = c(0,28), maximum = TRUE)

# Mostrar resultados
cat("Máximo aproximado de la muestra 1:", maximo_muestra1$maximum,"\n")
## Máximo aproximado de la muestra 1: 10.48862
cat("Máximo aproximado de la muestra 2:", maximo_muestra2$maximum,"\n")
## Máximo aproximado de la muestra 2: 9.289588
# Crear un data frame con los datos de los splines
datos_spline <- data.frame(dias = c(spline_muestra1$x,spline_muestra2$x),
                           peso = c(spline_muestra1$y,spline_muestra2$y),
                           muestra = rep(c("Muestra 1","Muestra 2"),each=length(spline_muestra1$x)))

# Crear el gráfico con ggplot
p <- ggplot(datos_spline,aes(x=dias,y=peso,color=muestra)) +
     geom_line() +
     labs(title="Peso promedio de las muestras (splines cúbicos)",
          x="Día",
          y="Peso promedio (mg)")+
  theme_bw()

# Convertir el gráfico en interactivo con ggplotly
ggplotly(p)

Ejercicio 4

Construye los splines cúbicos con \(n\) nodos, donde \(n=3,4,5\) para las siguientes funciones en el intervalo dado.

cubi <- function(f,f_expr,i,d){
  l<-i
  r<-d
  der<-D(f_expr,"x")
  d<-c()
  x<-i
  d[1]=eval(der)
  x<-d
  d[2]=eval(der)
  resultados <- list()
  
  for (n_nodos in 3:5) {
    x_n <- seq(l, r, length.out = n_nodos)
    f_n <- f(x_n)
    
    cubicspline(x_n, f_n, endp2nd = TRUE, der = c(d[1], d[2]))
    
    x_cs <- seq(l, r, length.out = 100)
    y_cs <- cubicspline(x_n, f_n, x_cs)
    y_cscond <- cubicspline(x_n, f_n, x_cs, endp2nd = TRUE, der = c(d[1], d[2]))
    
    # Guardar los resultados en la lista
    resultados[[paste0("x_", n_nodos)]] <- x_n
    resultados[[paste0("f_", n_nodos)]] <- f_n
    resultados[[paste0("x_cs", n_nodos)]] <- x_cs
    resultados[[paste0("y_cs", n_nodos)]] <- y_cs
    resultados[[paste0("y_cscond", n_nodos)]] <- y_cscond
  }
  graf_f<-ggplot()+
    geom_function(fun=f,color="deeppink3",linewidth=1.1)+
    geom_point(aes(resultados$x_3,resultados$f_3),size=2,color="blue3")+
    geom_line(aes(resultados$x_cs3,resultados$y_cs3),linewidth=.8,linetype="dashed",color="dodgerblue")+
    geom_line(aes(resultados$x_cs3,resultados$y_cscond3),linewidth=.8,linetype="dashed",color="dodgerblue3")+
    geom_point(aes(resultados$x_4,resultados$f_4),size=2,color="red3")+
    geom_line(aes(resultados$x_cs4,resultados$y_cs4),linewidth=.8,linetype="dashed",color="firebrick")+
    geom_line(aes(resultados$x_cs4,resultados$y_cscond4),linewidth=.8,linetype="dashed",color="firebrick3")+
    geom_point(aes(resultados$x_5,resultados$f_5),size=2,color="olivedrab")+
    geom_line(aes(resultados$x_cs5,resultados$y_cs5),linewidth=.8,linetype="dashed",color="green")+
    geom_line(aes(resultados$x_cs5,resultados$y_cscond5),linewidth=.8,linetype="dashed",color="green3")+
    xlim(l,r)+
    theme_minimal()
  ggplotly(graf_f)
}
  1. \(f(x) = e^{2x}\, cos 3x\), \([0,2]\).
f<-function(x){exp(2*x)*cos(3*x)}
f_expr<-expr(exp(2*x)*cos(3*x))
cubi(f,f_expr,0,2)
  1. \(f(x) = sen(log\,x)\), \([1,3]\).
f<-function(x){sin(log(x))}
f_expr<-expr(sin(log(x)))
cubi(f,f_expr,1,3)
  1. \(f(x) = e^{x}+e^{-x}\), \([0,2]\).
f<-function(x){exp(x)+exp(-x)}
f_expr<-expr(exp(x)+exp(-x))
cubi(f,f_expr,0,2)
  1. \(f(x) = cos \,x+sen\,x\), \([0,2\pi]\).
f<-function(x){cos(x)+sin(x)}
f_expr<-expr(cos(x)+sin(x))
cubi(f,f_expr,0,2*pi)

Ejercicio 5

Dada la partición \(x_0=0, x_1=0.5, x_2=1\), del intervalo \([0,1]\), encuentra el spline cúbico \(S\) para \(f(x)=e^{2x}\). Aproxima \(\int_0^{1} e^{2x}\,dx\) con \(\int_0^{1} S(x)\,dx\) y compara el resultado con el valor real.